TPUG - Toronto PET Users Group/TPUG Users Group CD/TPUG Users Group CD.iso/AMIGA/AMICUS/AMICUS20.ADF/Decoder/Compactor

AmigaBASIC Source Code | 1989-01-27 | 5KB | 123 lines

REM Compactor
REM Steve Michel   9/15/86    815-626-4157
REM 2510 16th Ave.  Sterling  IL  61081

REM  get file name to compact

  CLS: PRINT
  INPUT "Enter filename to compact";filename.in$
  PRINT: INPUT "Enter filename for compacted file"; filename.out$
  OPEN "I", #1, filename.in$, 1024
  OPEN "O", #2, filename.out$, 1024
  CLS: PRINT: PRINT "Now reading line  => "
  PRINT:  PRINT "Now writing line  => "
  DIM byte$(300)   ' assumes a single line not longer than 300 bytes
  lines.in = 0: lines.out = 0: bytes.in = 0: bytes.out = 0

REM directly copy file attribute bytes

  a$ = INPUT$ (1,#1): PRINT #2,a$;
  a$ = INPUT$ (1,#1): PRINT #2,a$;

REM start main read / write loop

loop:
  byte$(1)  = INPUT$ (1,#1)                 ' get linelength
  linelength = ASC(byte$(1))                ' check for end of BASIC text
  IF linelength = 0 THEN end.of.basic       ' if linelength is zero
                                            ' we're at end of basic text
REM read in line from input file
                                            ' not end of BASIC text, so
  bytes.in = bytes.in + linelength          ' count bytes in and
  lines.in = lines.in + 1                   ' increment line counter
  LOCATE 2,22: PRINT lines.in               ' and print it to screen
  FOR J = 2 TO linelength                   ' read rest of line one byte
    byte$(J) = INPUT$ (1,#1)                ' at a time into the
  NEXT J                                    ' array  - byte$()

REM check for blank line

  byte3   = ASC(byte$(3))                   ' check bytes 3 & 4 of line for
  byte4   = ASC(byte$(4))                   ' two zeros that indicate a
  IF byte3 = 0 AND byte4 = 0 THEN loop      ' blank line. if yes, skip line

REM check for leading apostrophe

  IF byte3 = 58 AND byte4 = 7*25 THEN loop  ' leading apostrophe. so skip

REM scan current line for imbedded REMs and '

  newlength = 0                             ' no leading REMs or apostrophes
  FOR J = 3 TO linelength                   ' so search for imbedded REMs
    IF byte$(J) = CHR$(174+1) THEN          ' and apostrophes. if found,
       newlength = J                        ' set position found and force
       J = 1e+09                            ' the loop to end
    END IF
  NEXT J

  IF newlength = 0 THEN setup.line          ' no REMs found so save line

REM embedded REM found, check for colon in front of it

  FOR J = newlength TO 3 STEP -1            ' start searching line backwards
    IF byte$(J) = CHR$(58) THEN             ' for a colon.  if found, set
       linelength = J + 1                   ' linelength to that position
       GOTO setup.line                      ' plus 1 and end search and
    END IF                                  ' setup line to write to new
  NEXT J                                    ' file

GOTO loop                                   ' no colon, so skip whole line

REM this routine sets up the line length, indentation and
REM two zero bytes at the end of the compacted line

setup.line:
  byte$(1) = CHR$(linelength)               ' reset line length
  byte$(2) = CHR$(0)                        ' reset line indentation
  byte$(linelength)   = CHR$(0)             ' set two zero bytes at the
  byte$(linelength-1) = CHR$(0)             ' end of the line

  bytes.out = bytes.out + linelength        ' count # of bytes written
  lines.out = lines.out + 1                 ' keep track of lines written
  LOCATE 4,22: PRINT lines.out              ' and display on screen
  FOR J = 1 TO linelength                   ' now write whole line out to
    PRINT #2, byte$(J);                     ' to compacted file
  NEXT J
  GOTO loop                                 ' and continue

REM add 2 zero bytes for end of BASIC and check for
REM ODD / EVEN file lengths and adjust if needed

end.of.basic:
  byte$ = INPUT$(1,#1)                      ' get 2nd zero byte from file
  IF bytes.in/2 = INT(bytes.in/2) THEN      ' if even number of bytes read,
    throwaway$ = INPUT$ (1,#1)              ' get rid of extra byte in front
  END IF                                    ' of variable table
  PRINT #2,CHR$(0);                         ' write the end of BASIC markers
  PRINT #2,CHR$(0);

  IF bytes.out/2 = INT(bytes.out/2) THEN    ' if even number of bytes written,
    PRINT #2,CHR$(ASC("J"));                ' add extra byte in front of
  END IF                                    ' variable table. (Thanks, Jay.)

REM copy variable table and icon files over

finish.up:
  GOSUB copy.rest                           ' copy rest of file
  OPEN "I", #1, filename.in$ + ".info"      ' copy icon information
  OPEN "O", #2, filename.out$ + ".info"     ' to provide a clickable icon
  GOSUB copy.rest                           ' copy icon file
  KILL filename.out$ + ".info.info"         ' delete extraneous file
  LOCATE 6,1: PRINT "All done !"            ' generated during copy process
  END                                       ' and voila !!!

copy.rest:
  byte$ = INPUT$ (1,#1)                     ' get next byte of old file
  PRINT #2, byte$;                          ' send to new file
  IF EOF(1) THEN                            ' check end of old file
    CLOSE #1                                ' done, so tidy everything up
    CLOSE #2
    RETURN                                  ' and go back
  END IF
  GOTO copy.rest                            ' otherwise, continue copying